home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Grab Bag
/
Shareware Grab Bag.iso
/
090
/
byte0987.arc
/
REUSESOF.ARC
/
SORTELEM.MOD
< prev
next >
Wrap
Text File
|
1986-07-15
|
3KB
|
122 lines
IMPLEMENTATION MODULE SortElemType;
(* FROM FileDescriptor IMPORT FileDescr; *)
FROM InOut IMPORT in, ReadString, WriteString, WriteLn, Write;
FROM Storage IMPORT ALLOCATE;
FROM Strings IMPORT Length, Concat, Copy;
CONST
EOS = 0C; (* End Of String *)
TYPE
ElemType = POINTER TO FileDescr;
FileDescr = RECORD (* File descriptor *)
name : ARRAY [0..8] OF CHAR;
ext : ARRAY [0..3] OF CHAR;
size : ARRAY [0..7] OF CHAR;
date : ARRAY [0..8] OF CHAR;
time : ARRAY [0..6] OF CHAR
END;
VAR
comp : PROCEDURE(ElemType,ElemType): BOOLEAN;
PROCEDURE compare (x, y: ElemType): BOOLEAN;
BEGIN (* call the procedure currently *)
RETURN comp(x,y) (* assigned to "comp" *)
END compare;
PROCEDURE compName (r1, r2: ElemType): BOOLEAN;
BEGIN
RETURN StringComp(r1^.name,r2^.name)
END compName;
PROCEDURE compExt (r1, r2: ElemType): BOOLEAN;
VAR temp1, temp2 : ARRAY [0..12] OF CHAR;
BEGIN (* compare by extension and then by name *)
Concat(r1^.ext,".",temp1); Concat(temp1,r1^.name,temp1);
Concat(r2^.ext,".",temp2); Concat(temp2,r2^.name,temp2);
RETURN StringComp(temp1,temp2)
END compExt;
PROCEDURE select (option: CARDINAL);
BEGIN
CASE option OF (* compare by: *)
1 : comp:= compName (* file-names *)
| 2 : comp:= compExt (* extension *)
ELSE comp:= compName (* default *)
END
END select;
PROCEDURE optionMenu;
BEGIN
WriteString("options:"); WriteLn;
WriteString(" 1 to sort by file-name"); WriteLn;
WriteString(" 2 to sort by extension"); WriteLn;
WriteString(" the default is 1, any other is taken as 1");
WriteLn; WriteLn
END optionMenu;
PROCEDURE ReadArray(VAR A: ARRAY OF ElemType): CARDINAL;
VAR n, max : CARDINAL;
temp : ARRAY [0..8] OF CHAR;
BEGIN
n:= 0; max:= HIGH(A);
ReadString(temp);
WHILE (NOT in.eof) & (n < max) DO
NEW(A[n]);
Copy(temp,0,30,A[n]^.name);
ReadString(A[n]^.ext);
ReadString(A[n]^.size);
ReadString(A[n]^.date);
ReadString(A[n]^.time);
ReadString(temp); INC(n)
END;
RETURN n
END ReadArray;
PROCEDURE WriteArray(A: ARRAY OF ElemType; n: CARDINAL);
VAR i : CARDINAL;
BEGIN
FOR i:= 0 TO n-1 DO
WriteFString(A[i]^.name,-11);
WriteFString(A[i]^.ext,-6);
WriteFString(A[i]^.size,12);
WriteFString(A[i]^.date,10);
WriteFString(A[i]^.time,8); WriteLn
END
END WriteArray;
PROCEDURE WriteFString (s: ARRAY OF CHAR; f: INTEGER);
(* Write string "s" formated in a field of size f.
IF f < 0 string is left justified
IF f > 0 string is right justified
IF Length(s) > f string is truncated
padding is done with blanks
*)
VAR i, n: INTEGER;
c : CHAR;
BEGIN
n:= Length(s);
IF f > 0 THEN FOR i:= 1 TO f-n DO Write(' ') END END;
i:= 0;
REPEAT c:= s[i]; Write(c); INC(i)
UNTIL (i >= n) OR (i >= ABS(f));
IF f < 0 THEN FOR i:= 1 TO -f-n DO Write(' ') END END
END WriteFString;
PROCEDURE StringComp (s1, s2: ARRAY OF CHAR): BOOLEAN;
(* returns s1 < s2 *)
VAR i, max : CARDINAL;
BEGIN
i:= 0; max:= HIGH(s1);
WHILE (i < max) & (s1[i] = s2[i]) DO
IF s1[i] = EOS
THEN RETURN FALSE (* s1 = s2 *)
ELSE INC(i)
END
END;
RETURN s1[i] < s2[i]
END StringComp;
BEGIN
comp:= compName (* default *)
END SortElemType.